;; math/math.scm - (c) rohan drape, 2001-2005

;; Basic operations not in R5RS.

(define (square x)       (* x x))
(define (cube x)         (* x x x))
(define (reciprocal x)   (/ 1 x))
(define (reciprocal. x)  (/ 1.0 x))
(define (log2 x)         (* (log (abs x)) reciprocal-of-log-of-two))
(define (log10 x)        (/ (log x) log-of-ten))
(define (sinh x)         (/ (- (exp x) (exp (- x))) 2.0))
(define (cosh x)         (/ (+ (exp x) (exp (- x))) 2.0))
(define (tanh x)         (/ (sinh x) (cosh x)))
(define (identity x)     x)
(define (mod12 x)        (modulo x 12))
(define (sinU x)         (sin (* 2 pi x)))
(define (cosU x)         (cos (* 2 pi x)))
(define (tanU x)         (tan (* 2 pi x)))
(define (atan2 y x)      (atan y x))
(define (atan2* y x)     (if (and (zero? y) (zero? x)) 0 (atan2 y x)))
(define (hypotenuse x y) (sqrt (+ (* x x) (* y y))))
(define (negative x)     (- x))

;; R -> (R -> R)

(define (+N n) (lambda (z) (+ z n)))
(define (*N n) (lambda (z) (* z n)))
(define (/N n) (lambda (z) (/ z n)))
(define (-N n) (lambda (z) (- z n)))

;; Binary math on <list>s.
;; {R,...} -> {R,...} -> {R,...}

(define (+L a b) (map + a b))
(define (*L a b) (map * a b))
(define (/L a b) (map / a b))
(define (-L a b) (map - a b))

;; Binary math on unary <function>s.
;; (a -> R) -> (a -> R) -> (a -> R)

(define (+F a b) (lambda (n) (+ (a n) (b n))))
(define (*F a b) (lambda (n) (* (a n) (b n))))
(define (/F a b) (lambda (n) (/ (a n) (b n))))
(define (-F a b) (lambda (n) (- (a n) (b n))))

;; Binary math on unary <function>s generating <list>s.
;; (a -> {R,...}) -> (a -> {R,...}) -> (a -> {R,...})

(define (+FL a b) (lambda (n) (+L (a n) (b n))))
(define (*FL a b) (lambda (n) (*L (a n) (b n))))
(define (/FL a b) (lambda (n) (/L (a n) (b n))))
(define (-FL a b) (lambda (n) (-L (a n) (b n))))

;; Clip `n' between a and b.

(define (clip n a b)  (if (< n a) a (if (> n b) b n)))
(define (clip= n a b) (if (<= n a) a (if (>= n b) b n)))
(define (clipR n b)   (if (> n b) b n))
(define (clipR= n b)  (if (>= n b) b n))
(define (clipL n a)   (if (< n a) a n))
(define (clipL= n a)  (if (<= n a) a n))
(define (clipU n)     (clip n 0 1))
(define (clipU= n)    (clip= n 0 1))
(define (clipF a b)   (lambda (n) (clip n a b)))
(define (clipF= a b)  (lambda (n) (clip= n a b)))
